Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/card_21108.txt

Text File | 1990-04-17 | 12KB | 381 lines

-- card: 21108 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: TextStream
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,TextStream,it
end Install


-- part 1 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=57 top=300 right=322 bottom=214
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: TextStream Example
----- HyperTalk script -----
on mouseUp
  global leftMargin,topMargin,rightMargin,bottomMargin
  put 8 into leftMargin
  put 4 into topMargin
  put 10 into rightMargin
  put 4 into bottomMargin
  textstream field 1
  get the result
  if it is not empty then put it
end mouseUp



-- part 3 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
TEXTSTREAM XCMD version 2.0
Kevin Calhoun

NOTE TO USERS OF VERSIONS EARLIER THAN 2.0:
TextStream has been completely rewritten and the parameter list has changed.  Please read the complete documentation before replacing earlier versions in your stacks with TextStream 2.0.  The revisions were necessary to accommodate users who wanted to use TextStream to print mailing labels.

NOTE TO USERS OF LASERWRITER DRIVER VERSION 5.2:
Under the following circumstance, a fatal system error can occur when using TextStream with Apple's LaserWriter Driver version 5.2.  Under Finder or under MultiFinder with background printing turned off, if the currently selected LaserWriter is not present on the network, the LaserWriter Driver may crash when TextStream tells it to close.  This crash does not occur if the currently selected LaserWriter is up and running.  The problem is in the LaserWriter driver; it was not present in version 5.0, and it is not present in the latest version at this writing, version 6.0.

The TextStream XCMD prints the contents of up to 16 HyperTalk containers using your printer's built-in font.  You have the option of telling TextStream how many characters wide you want your left and right margins to be and how many lines tall you want your top and bottom margins to be.

In case of an error, TextStream returns an error message as the Result.  Word 1 of this message will be "Error."

TextStream works with both the LaserWriter and the ImageWriter.  It is intended primarily for use with eight-and-a-half by eleven inch sheets, although you can use it with smaller sheets by providing appropriate margin settings.

INVOKING TEXTSTREAM

TextStream firstContainer,<secondContainer>,<thirdContainer>,...,<sixteenthContainer>

Do not place quotation marks around the names of the containers.  Parameters given inside the brackets, such as  <notNeeded>,  are optional.

SETTING MARGINS
TextStream looks in HyperTalk global variables for margin information.  The global variables leftMargin and rightMargin contain the number of characters to skip at the start and the end of each line.  The global variables topMargin and bottomMargin are the numbers of lines to skip at the top and the bottom of each page.

If these global variables are empty (or if they contain unreasonable numbers for margins), TextStream will default to 96 chars per line and 63 lines per page, which is as much as either the LaserWriter or the ImageWriter can fit on an eight-and-a-half by eleven inch page.

CHANGE HISTORY
7 March 1988 -- 1.0
7 April 1988 -- 1.2  Prints any container, not just fields.
15 March 1989 -- 1.5  Altered source code for compatibility with MPW Pascal 3.0.
18 June 1989 -- 2.0.  Complete rewrite.  No longer forces a page feed after printing each container.  No longer crashes after PrintField.

-- part contents for card part 1
----- text -----
UNIT TextStreamUnit;

{ TextStream XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal Textstream.p
Link -m ENTRYPOINT Γêé
     -o "YourFile" Γêé
     -rt XCMD=9541 Γêé
     -sn Main=TextStream Γêé
     Textstream.p.o Γêé
    "{Libraries}"interface.o Γêé
    "{PLibraries}"Paslib.o Γêé
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    QuickDraw,
    Windows,
    ToolUtils,
    Devices,
    PrintTraps,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);

IMPLEMENTATION

  PROCEDURE TextStream(paramPtr : XCMDPtr); FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCmdPtr);
  BEGIN
    TextStream(paramPtr);
  END;

  PROCEDURE PassReturnValue (paramPtr: XCMDPtr; errMsg : Str255);
    { set theResult }
  BEGIN
    paramPtr^.returnValue := PasToZero(paramPtr, errMsg);
  END;

  PROCEDURE GetMargins (paramPtr : XCmdPtr;
                  VAR leftMargin, rightMargin, topMargin, bottomMargin : INTEGER);
    VAR
      hndl : Handle;

    FUNCTION HandleToNum (h : Handle) : LONGINT;
      VAR
        temp : Str255;
    BEGIN
      ZeroToPas(paramPtr, h^, temp);
      HandleToNum := StrToNum(paramPtr, temp);
    END;

  BEGIN
    leftMargin := 0;
    topMargin := 0;
    rightMargin := 0;
    bottomMargin := 0;
    hndl := GetGlobal(paramPtr,'leftMargin');
    IF paramPtr^.result = noErr THEN
      BEGIN
      leftMargin := HandleToNum(hndl);
      DisposHandle(hndl);
      END;
    hndl := GetGlobal(paramPtr,'topMargin');
    IF paramPtr^.result = noErr THEN
      BEGIN
      topMargin := HandleToNum(hndl);
      DisposHandle(hndl);
      END;
    hndl := GetGlobal(paramPtr,'rightMargin');
    IF paramPtr^.result = noErr THEN
      BEGIN
      rightMargin := HandleToNum(hndl);
      DisposHandle(hndl);
      END;
    hndl := GetGlobal(paramPtr,'bottomMargin');
    IF paramPtr^.result = noErr THEN
      BEGIN
      bottomMargin := HandleToNum(hndl);
      DisposHandle(hndl);
      END;
  END;

  PROCEDURE StartPage (topMargin : INTEGER);
    VAR
      i : INTEGER;
  BEGIN
    PrCtlCall(iPrDevCtl, lPrPageOpen, 0, 0);  {init for new page}
    FOR i := 1 TO topMargin DO
      BEGIN
      PrCtlCall(iPrDevCtl, lPrLineFeed, 0, 0);  {send CR and LF}
      PrCtlCall(iPrDevCtl, lPrLFStd, 0, 0);
      END;
  END;

  PROCEDURE Text2Printer(paramPtr: XCMDPtr; textHndl: Handle; charsPerLine: INTEGER;
                        linesPerPage: INTEGER; leftMargin: INTEGER; marginPtr: CharsPtr;
                        topMargin: INTEGER; VAR linesUsed: INTEGER);
  VAR
    strLength: INTEGER;
    charCount: INTEGER;
    lineCount: INTEGER;
    returnFlag: BOOLEAN;
    hndlState: SignedByte;
    charsToPrint: INTEGER;
    leadingBlanks: INTEGER;
    startLinePtr: Ptr;
    endLinePtr: Ptr;
    lineLength: INTEGER;
    blankPos: INTEGER;

  BEGIN
    strLength := StringLength(paramPtr, textHndl^);
    IF strLength > 0 THEN
      BEGIN
      charCount := 0;
      lineCount := linesUsed;
      returnFlag := TRUE;
      hndlState := HGetState(textHndl);
      MoveHHi(textHndl);
      HLock(textHndl);

      REPEAT
        { print a page }
        REPEAT
          { print a line }
          charsToPrint := charsPerLine;

          IF NOT returnFlag THEN
          { if previous line did not end with a carriage return, skip leading blanks }
            BEGIN
            leadingBlanks := 0;
            WHILE CharsHandle(textHndl)^^[charCount+leadingBlanks] = CHR($20) DO
              leadingBlanks := leadingBlanks + 1;
            charCount := charCount + leadingBlanks;
            END;

          startLinePtr := Ptr(ORD4(textHndl^)+charCount);
          endLinePtr := startLinePtr;
          ScanToReturn(paramPtr, endLinePtr);
          lineLength := ORD4(endLinePtr) - ORD4(startLinePtr) + 1;
          IF lineLength <= charsToPrint + 1 THEN
            BEGIN
            returnFlag := TRUE;
            charsToPrint := lineLength;
            END
          ELSE
            BEGIN
             { we have to wrap this line }
            returnFlag := FALSE;
            blankPos := charsToPrint + 1; { look for the last blank before the 98th char }
            WHILE (CharsHandle(textHndl)^^[charCount+blankPos-1] <> CHR($20)) AND (blankPos > 1) DO
              blankPos := blankPos - 1;
              { if there are no blanks on the line, we print 96 chars -- }
              { otherwise print up to and including last blank before 98th char }
            IF blankPos > 1 THEN charsToPrint := blankPos;
            END;

          IF leftMargin > 0 THEN PrCtlCall(iPrIOCtl, ORD(marginPtr), leftMargin, 0);

          PrCtlCall(iPrIOCtl, ORD(startLinePtr), charsToPrint, 0);  {send the line}
          PrCtlCall(iPrDevCtl, lPrLineFeed, 0, 0);  {send CR and LF}
          PrCtlCall(iPrDevCtl, lPrLFStd, 0, 0);
          charCount := charCount + charsToPrint;
          lineCount := lineCount + 1;
        UNTIL (lineCount = linesPerPage) OR (charCount >= strLength);
        IF lineCount = linesPerPage THEN
          BEGIN
          PrCtlCall(iPrDevCtl, lPrPageEnd, 0, 0);  {send end page}
          StartPage(topMargin);
          lineCount := 0;
          END;
      UNTIL charCount >= strLength;
      HSetState(textHndl,hndlState);
      linesUsed := lineCount;
    END;  { if strLength > 0 }
  END;

  PROCEDURE TextStream (paramPtr : XCmdPtr);
    LABEL
      99;
    VAR
      err : OSErr;
      parameterCount : INTEGER;
      leftMargin, rightMargin, topMargin, bottomMargin : INTEGER;
      linesPerPage, lineLength : INTEGER;
      marginHndl: CharsHandle;
      marginPtr: CharsPtr;
      i, curParam : INTEGER;
      theText : Handle;
      linesUsed: INTEGER;
      watchHdl : CursHandle;
      str : Str255;

  BEGIN
    parameterCount := paramPtr^.paramCount;
    IF parameterCount < 1 THEN
      BEGIN
      PassReturnValue(paramPtr,'TextStream XCMD 2.0, 18 June 1989, ©1988-1989 Dartmouth College');
      GOTO 99;
      END;

    err := noErr;
    GetMargins(paramPtr, leftMargin, rightMargin, topMargin, bottomMargin);
    lineLength := 96 - leftMargin - rightMargin;
    IF lineLength <= 0 THEN GOTO 99;
    linesPerPage := 63 - topMargin - bottomMargin;
    IF linesPerPage <= 0 THEN GOTO 99;

    marginHndl := NIL;
    IF leftMargin > 0 THEN
      BEGIN
      marginHndl := CharsHandle(NewHandle(leftMargin));
      err := MemError;
      IF err <> noErr THEN GOTO 99;
      MoveHHi(Handle(marginHndl));
      HLock(Handle(marginHndl));
      FOR i := 0 TO (leftMargin - 1) DO marginHndl^^[i] := CHR($20);
      marginPtr := marginHndl^;
      END
    ELSE marginPtr := NIL;

    PrDrvrOpen;
    err := PrError;
    IF err = noErr THEN
      BEGIN
      watchHdl := GetCursor(watchCursor);
      SetCursor(watchHdl^^);

      PrCtlCall(iPrDevCtl, lPrReset, 0, 0);
      err := PrError;
      IF err = noErr THEN
        BEGIN
        StartPage(topMargin);
        linesUsed := 0;
        FOR curParam := 1 to parameterCount DO
          BEGIN
          theText := paramPtr^.params[curParam];
          Text2Printer(paramPtr,theText,lineLength,linesPerPage,
                      leftMargin,marginPtr,topMargin,linesUsed);
          END;

        IF linesUsed < linesPerPage THEN
          PrCtlCall(iPrDevCtl, lPrPageEnd, 0, 0);  { send end page }
        PrCtlCall(iPrDevCtl, lPrDocClose, 0, 0);  { end doc }
        END;
      PrDrvrClose;
      InitCursor;
      END;

    IF marginHndl <> NIL THEN DisposHandle(Handle(marginHndl));

    99: IF err <> noErr then
      BEGIN
      NumToStr(paramPtr,err,str);
      PassReturnValue(paramPtr, CONCAT('Error ',str));
      END;

  END;

END.